home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / bin / update-perl-sax-parsers < prev    next >
Text File  |  2008-05-03  |  6KB  |  195 lines
  1. #!/usr/bin/perl
  2. ## ----------------------------------------------------------------------
  3. ## Debian update-perl-sax-parsers version 0.3
  4. ## ----------------------------------------------------------------------
  5. ## Copyright (C) 2001-2003 Ardo van Rangelrooij
  6. ## Copyright (C) 2007      Niko Tyni
  7. ##
  8. ## This is free software; see the GNU General Public Licence version 2
  9. ## or later for copying conditions.  There is NO warranty.
  10. ## ----------------------------------------------------------------------
  11.  
  12. ## ----------------------------------------------------------------------
  13. use strict;
  14.  
  15. ## ----------------------------------------------------------------------
  16. use File::Spec;
  17. use Getopt::Long;
  18. use XML::SAX;
  19. use File::Temp qw(tempfile);
  20.  
  21. ## ----------------------------------------------------------------------
  22. $0  =~ m|[^/]+$|;
  23.  
  24. ## ----------------------------------------------------------------------
  25. my $name = $&;
  26.  
  27. ## ----------------------------------------------------------------------
  28. my $add       = '';
  29. my @directory = ();
  30. my $file      = '';
  31. my $help      = '';
  32. my $quiet     = '';
  33. my $remove    = '';
  34. my $test      = '';
  35. my $update    = '';
  36. my $version   = '';
  37. my $ucf;
  38. my $priority;
  39.  
  40. ## ----------------------------------------------------------------------
  41. if ( ! GetOptions(
  42.           'add=s'       => \$add,
  43.           'directory=s' => \@directory,
  44.           'file=s'      => \$file,
  45.           'help'        => \$help,
  46.           'quiet'       => \$quiet,
  47.           'remove=s'    => \$remove,
  48.           'test'        => \$test,
  49.           'update'      => \$update,
  50.           'version'     => \$version,
  51.           'priority=i'  => \$priority,
  52.           'ucf=i'       => \$ucf,
  53.           )
  54.      )
  55. {
  56.     &usage;
  57.     exit 1;
  58. }
  59.  
  60.  
  61. ## ----------------------------------------------------------------------
  62. if ( $version )
  63. {
  64.     &version;
  65.     exit 0;
  66. }
  67.  
  68. ## ----------------------------------------------------------------------
  69. if ( $help )
  70. {
  71.     &usage;
  72.     exit 0;
  73. }
  74.  
  75. ## ----------------------------------------------------------------------
  76. print STDERR "$name: test mode - Perl SAX parsers file will not be updated\n"
  77.     if $test && ! $quiet;
  78.  
  79. ## ----------------------------------------------------------------------
  80. # default priority is 50 unless --directory was specified
  81. # with --directory, default to 0 (no priority in the filenames)
  82. $priority = (@directory ? 0 : 50) if not defined $priority;
  83.  
  84. ## ----------------------------------------------------------------------
  85. my $PARSER_DETAILS_DIR  = "/var/lib/libxml-sax-perl/ParserDetails.d";
  86. push( @directory, $PARSER_DETAILS_DIR) if ! @directory;
  87.  
  88. ## ----------------------------------------------------------------------
  89. # use ucf by default if --file is not specified
  90. $ucf  = ($file ? 0 : 1) if not defined $ucf;
  91.  
  92. ## ----------------------------------------------------------------------
  93. my $PARSER_DETAILS_FILE = "/etc/perl/XML/SAX/ParserDetails.ini";
  94. $file = $PARSER_DETAILS_FILE if ! $file;
  95.  
  96. ## ----------------------------------------------------------------------
  97. if ( $add )
  98. {
  99.     print "$name: Registering Perl SAX parser $add with priority $priority...\n"
  100.         unless $quiet;
  101.     
  102.     if (XML::SAX->can('save_parsers_debian')) {
  103.         XML::SAX->save_parsers_debian( $add, $directory[0], $priority );
  104.     } else {
  105.         print STDERR <<EOF;
  106. Fatal: cannot call XML::SAX->save_parsers_debian(). 
  107. You probably have a locally installed XML::SAX module.
  108. See /usr/share/doc/libxml-sax-perl/README.Debian.gz .
  109. EOF
  110.         exit 1;
  111.     }
  112. }
  113. elsif ( $remove )
  114. {
  115.     print "$name: Unregistering Perl SAX parser $remove with priority $priority...\n"
  116.         unless $quiet;
  117.     
  118.     my $parser_file = $remove;
  119.     $parser_file = "${priority}-$parser_file" if $priority != 0;
  120.     $parser_file = File::Spec->catfile( $directory[0], $parser_file );
  121.     unlink( $parser_file );
  122. }
  123. elsif ( $update )
  124. {
  125.     print "$name: Updating overall Perl SAX parser modules info file...\n"
  126.         unless $quiet;
  127.  
  128.     my ($handle, $tmpfile);
  129.  
  130.     if ($ucf) {
  131.         ($handle, $tmpfile) = tempfile();
  132.         chmod 0644, $tmpfile or die("chmod $tmpfile: $!");
  133.     } else {
  134.         open( $handle, ">$file" )
  135.             || die "Cannot write to $file: $!";
  136.     }
  137.     foreach my $directory ( @directory)
  138.     {
  139.     opendir( PARSER_DETAILS_DIR, $directory )
  140.         || die "Cannot access $directory: $!";
  141.     my @files = sort readdir ( PARSER_DETAILS_DIR );
  142.     for my $parser_details ( @files )
  143.     {
  144.         next if $parser_details =~ /^\.\.?$/; # skip . and ..
  145.         open( PARSER_DETAILS, "$directory/$parser_details" )
  146.         || die "Cannot read from $parser_details: $!";
  147.         while ( <PARSER_DETAILS> ) { print $handle $_; }
  148.         close( PARSER_DETAILS );
  149.     }
  150.     closedir( PARSER_DETAILS_DIR );
  151.     }
  152.     close( $handle );
  153.     if ($ucf) {
  154.         system("ucf --debconf-ok --sum-file /var/lib/libxml-sax-perl/ParserDetails.ini.md5sum $tmpfile $file");
  155.         unlink $tmpfile or die("unlink $tmpfile: $!");
  156.     }
  157. }
  158.  
  159. ## ----------------------------------------------------------------------
  160. exit 0;
  161.  
  162. ## ----------------------------------------------------------------------
  163. sub usage
  164. {
  165.     print STDERR <<END;
  166. Usage:
  167.     $name <options> --add <parser_module>
  168.     $name <options> --remove <parser_module>
  169.     $name <options> --update
  170.  
  171. Options:
  172.     --directory     Perl SAX parser module info file directory to be used
  173.                     as target for 'add'/'remove' or as sources for 'update'
  174.                     (default = '/var/lib/libxml-sax-perl/ParserDetails.d')
  175.     --priority      The priority of the parser to add. The parser with the
  176.                     highest priority is the default parser.
  177.     --file          Perl SAX parser module info file to be updated
  178.                     (default = '/etc/perl/XML/SAX/ParserDetails.ini')
  179.     --ucf X         Forcibly disable (X == 0) or enable (X != 0) the use
  180.                     of ucf with '--update'.
  181.     --help          display this help text (usage)
  182.     --quiet         be quiet
  183.     --test          do not modify any files, enable debugging mode
  184.     --version       display version number
  185. END
  186. }
  187.  
  188. ## ----------------------------------------------------------------------
  189. sub version
  190. {
  191.     print "Debian $name version 0.3\n";
  192. }
  193.  
  194. ## ----------------------------------------------------------------------
  195.